' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2025.02.23 at 23:22 (Coordinated Universal Time)
' This program by Charlie Veniot is a port of a QBJS program by vince
' vince's program found at: https://qb64phoenix.com/forum/showthread.php?tid=3488&pid=32256#pid32256

DECLARE SUB proj
DECLARE SUB tri(a, b, c)
DECLARE SUB rot(u, rx, ry, rz)

CONST fc& = _RGB(255,255,255) ' white line color

dim xx(4*3), yy(4*3), zz(4*3)
dim x, y, z
dim p, q
dim zoom

dim phi
dim rotx, roty, rotz
rotx = 1
roty = 1
rotz = 1


phi = 0

zoom = 150

dim sw, sh
sw = 800
sh = 600
screen _newimage(sw, sh, 27) 

zoom = sh/3

w = 0.5
l = 1

xx(0) = -w
yy(0) = -l
zz(0) = 0
xx(1) = w
yy(1) = -l
zz(1) = 0
xx(2) = w
yy(2) = l
zz(2) = 0
xx(3) = -w
yy(3) = l
zz(3) = 0
for i=0 to 3
    x = xx(i)
    y = yy(i)
    z = zz(i)
    rot ( _pi/2, 1,0,0 )
    rot ( _pi/2, 0,0,1 )
    xx(4 + i) = x
    yy(4 + i) = y
    zz(4 + i) = z
next
for i=0 to 3
    x = xx(i)
    y = yy(i)
    z = zz(i)
    rot ( _pi/2, 0,1,0 )
    rot ( _pi/2, 0,0,1 )
    xx(8 + i) = x
    yy(8 + i) = y
    zz(8 + i) = z
next

dim c(2)
c(0) = _rgb(100,0,0)
c(1) = _rgb(0,100,0)
c(2) = _rgb(0,0,100)
for j=0 to 2
    color c(j)
    x = xx(4*j)
    y = yy(4*j)
    z = zz(4*j)
    proj
    preset (sw/2 + p*zoom, sh/2 - q*zoom)
    for i=1 to 3
        x = xx(4*j + i)
        y = yy(4*j + i)
        z = zz(4*j + i)
        proj
        line -(sw/2 + p*zoom, sh/2 - q*zoom)
    next
    x = xx(4*j)
    y = yy(4*j)
    z = zz(4*j)
    proj
    line -(sw/2 + p*zoom, sh/2 - q*zoom)
next

drag = 0
ox = 0
oy = 0

do
    phi = phi + 0.01

    cls

    'minor faces
    tri ( 0, 4+0, 1 )
    tri ( 0, 1, 4+3 )
    tri ( 2, 4+1, 3 )
    tri ( 2, 3, 4+2 )

    tri ( 4+0, 4+1, 8+1 )
    tri ( 4+0, 8+2, 4+1 )
    tri ( 4+2, 4+3, 8+0 )
    tri ( 4+2, 8+3, 4+3 )

    tri ( 8+0, 1, 8+1 )
    tri ( 8+2, 0, 8+3 )
    tri ( 8+2, 8+3, 3 )
    tri ( 8+0, 8+1, 2 )

    'major faces
    tri (0, 4+3, 8+3 )
    tri ( 0, 8+2, 4+0 )
    tri ( 1, 8+0, 4+3 )
    tri ( 1, 4+0, 8+1 )

    tri ( 2, 4+2, 8+0 )
    tri ( 3, 8+3, 4+2 )
    tri ( 2, 8+1, 4+1 )
    tri ( 3, 4+1, 8+2 )

    SLEEP 0.001
loop

END

sub proj
    d = 10
    y0 = 10

    rot ( phi, rotx, roty, rotz )

    p = x*d/(y0 + y)
    q = z*d/(y0 + y)

end sub

sub tri(a, b, c)
    'centroid
    x = (xx(a) + xx(b) + xx(c))/3
    y = (yy(a) + yy(b) + yy(c))/3
    z = (zz(a) + zz(b) + zz(c))/3
    cx = x
    cy = y
    cz = z
    proj
    rcy = y
    
    x = xx(b) - xx(a)
    y = yy(b) - yy(a)
    z = zz(b) - zz(a)
    proj
    x1 = x
    y1 = y
    z1 = z
    
    x = xx(b) - xx(c)
    y = yy(b) - yy(c)
    z = zz(b) - zz(c)
    proj
    x2 = x
    y2 = y
    z2 = z

    x1 = xx(b) - xx(a)
    y1 = yy(b) - yy(a)
    z1 = zz(b) - zz(a)
    
    x2 = xx(b) - xx(c)
    y2 = yy(b) - yy(c)
    z2 = zz(b) - zz(c)

    px = y1*z2 - z1*y2
    py = z1*x2 - x1*z2
    pz = x1*y2 - y1*x2

    x = cx - px
    y = cy - py
    z = cz - pz
    proj
   
    x = px
    y = py
    z = pz
    proj
    if y<0.1 then
        x = xx(a)
        y = yy(a)
        z = zz(a)
        proj
        tx1 = sw/2 + p*zoom
        ty1 = sh/2 - q*zoom

        x = xx(b)
        y = yy(b)
        z = zz(b)
        proj
        tx2 = sw/2 + p*zoom
        ty2 = sh/2 - q*zoom

        x = xx(c)
        y = yy(c)
        z = zz(c)
        proj
        tx3 = sw/2 + p*zoom
        ty3 = sh/2 - q*zoom

        x = xx(a)
        y = yy(a)
        z = zz(a)
        proj

        c = 50 + rcy*100

        preset (tx1,ty1)
        line -(tx2,ty2), fc&
        line -(tx3,ty3), fc&
        line -(tx1,ty1), fc&

        paintx% = INT([tx1 + tx2 + tx3]/3)
        painty% = INT([ty1 + ty2 + ty3]/3)

       IF POINT(paintx% + 1, painty%) <> fc& _
          AND POINT(paintx% - 1, painty%) <> fc& _
       THEN PAINT ( paintx%, painty% ), _rgb(c,c,c), fc&
       
    end if

end sub

sub rot(u, rx, ry, rz)
    dd = sqr(rx*rx + ry*ry + rz*rz)
    rx = rx/dd
    ry = ry/dd
    rz = rz/dd

    x1 = x
    y1 = y
    z1 = z

    x2 = ry*z - rz*y
    y2 = rz*x - rx*z
    z2 = rx*y - ry*x

    dt = x*rx + y*ry + z*rz
    x3 = rx*dt
    y3 = ry*dt
    z3 = rz*dt

    cu = cos(u)
    su = sin(u)

    x = x1*cu + x2*su + x3*(1 - cu)
    y = y1*cu + y2*su + y3*(1 - cu)
    z = z1*cu + z2*su + z3*(1 - cu)
end sub